Eagles Nest BBS 8/Eagles_Nest_Mac_Collection_Disc_8.TOAST/Developer Tools⁄Additions/MacsbugBook/MacsBug Book Disk/Debugger Prefs sources/RD.p/RD.p

Text File | 1990-11-14 | 10.6 KB | 449 lines | [TEXT/MPS ]

UNIT RD;

(* The following MPW commands will build the dcmd and copy it to the
   "Debugger Prefs" file in the System folder. The dcmd's name in
         MacsBug will be the name of the file built by the Linker.

        Pascal RD.p
        Link dcmdGlue.a.o RD.p.o "{Libraries}Runtime.o" "{PLibraries}PasLib.o" -o RD
        BuildDcmd RD 200
        Echo 'include "RD";'    |    Rez -a -o "{systemFolder}Debugger Prefs"
*)

{$R-}

INTERFACE

        USES MemTypes, dcmd;

  { Public declaration for dcmdGlue. Must be in every dcmd. The name cannot be changed. }
PROCEDURE CommandEntry(paramBlk:DCmdBlockPtr);


IMPLEMENTATION

PROCEDURE NumberToHex (number: LONGINT; VAR hex: Str255; len: INTEGER);
VAR digits: Str255;
    t: Str255;
    n: INTEGER;
     num: LONGINT;
BEGIN
        num := ABS(number);
          digits := '0123456789ABCDEF';
        hex := '';
        t := '0';
        FOR n := len DOWNTO 1 DO
            BEGIN
                t[1] := digits[1 + (num MOD 16)];
                hex := Concat(t,hex);
                num := num DIV 16;
            END;
        IF number < 0 THEN hex := Concat('-',hex);
END;

PROCEDURE NumberToDecimal (number: LONGINT; VAR decimal: Str255; len: INTEGER);
VAR digits: Str255;
    t: Str255;
    n: INTEGER;
     num: LONGINT;
     signChar: Str15;
BEGIN
        IF number < 0 THEN
            signChar := '-'
        ELSE signChar := ' ';
        num := ABS(number);
          digits := '0123456789';
        decimal := '';
        t := '0';
        FOR n := len DOWNTO 1 DO
            BEGIN
                t[1] := digits[1 + (num MOD 10)];
                IF (num = 0) AND (n < len) THEN
                    BEGIN
                        decimal := Concat(signChar,decimal);
                        signChar := ' ';
                    END
                ELSE decimal := Concat(t,decimal);
                num := num DIV 10;
            END;
END;

{ Fixed and Translated to Pascal by Jim Straus
        from source translated to Modula-2 by Keith Nemitz
        from source written by Julia Menapace. (8/88) }

TYPE
    ResMap = RECORD
                    dataOffset    :LongInt; { from BOF to resource data. }
                    mapOfset        :LongInt; { from BOF to resource map. }
                    dataLength    :LongInt;
                    mapLength    :LongInt;

                    nextMap        :Handle;
                    fRefNum        :INTEGER;
                    fAttrs        :INTEGER;
                    typeListOffset :INTEGER; { from map to type list. }
                    nameListOffset :INTEGER; { from map to name list. }
                    END;
    ResMapPtr = ^ResMap;
    ResMapHnd = ^ResMapPtr;

    TypeList = RECORD
                        count    :INTEGER; { number of elements minus 1 }
                        list    :ARRAY [0..0] OF
                                    RECORD
                                        rType    :ResType;
                                        cnt    :INTEGER; { number of resources minus 1 }
                                        offset:INTEGER; { from typelist to RefList }
                                        END;
                        END;
    TypeListPtr = ^TypeList;

    rAttributes = (q0,q1,q2,q3,q4,q5,q6,q7,q8,
                        changed,preload,protected,locked,purgable,sysAppHeap,{ 1 = sys, 0 = app }
                        q15);
    rAttrSet = SET OF rAttributes;

    RefList = ARRAY [0..0] OF
                    RECORD
                        idNum            :INTEGER;
                        nameOffset    :INTEGER;    { from namelist to lenByte. -1 if no name. }
                        CASE INTEGER OF
                        1:    ( resAttrs    :rAttrSet;    { also the resOffset from resource data to length of resource }
                            xresource        :Handle);
                        2:    ( resOffset    :LongInt;    { fffset from resource data to length of resource }
                            resource        :Handle);     { handle to resource }
                    END;
    RefListPtr = ^RefList;

    LongPtr    = ^LongInt;

VAR
    ShowType :ResType;
    FileNum,ResNum :INTEGER;
    FileName :Str255;
    allTypes,allNums,allFiles :BOOLEAN;

PROCEDURE DisplayHelp(s:Str255); FORWARD;
FUNCTION ParseParameters:BOOLEAN; FORWARD;
PROCEDURE GetFileName(fRefNum:LongInt; VAR t:Str255); FORWARD;
FUNCTION StrCmp(s1,s2:Str255):BOOLEAN; FORWARD;
PROCEDURE ResTypes(typList:TypeListPtr; names:StringPtr; VAR abort:BOOLEAN); FORWARD;

{Skips leading spaces on the command line}
FUNCTION SkipSpace(ch: CHAR):CHAR;
BEGIN
    IF ch = ' ' THEN
        BEGIN
            ch := dcmdPeekAtNextChar;
            WHILE ch = ' ' DO
                BEGIN
                    ch := dcmdGetNextChar;
                    ch := dcmdPeekAtNextChar;
                END;{while}
        END;
    SkipSpace := ch;
END;

{Parses a file name or file refnum}
FUNCTION ParseFileReq(ch:CHAR):BOOLEAN;
VAR
    n :LONGINT;
    flag :BOOLEAN;
    str :Str255;
BEGIN
    FileName := ''; FileNum := 0;
    allFiles := FALSE;
    ch := SkipSpace(ch);
    IF (ch = '''') OR (ch = '"') THEN
        BEGIN
        ch := dcmdGetNextParameter(FileName);
        ParseFileReq := TRUE;
        END
    ELSE BEGIN
        ch := dcmdGetNextExpression(n,flag);
        IF flag THEN
            BEGIN
            FileNum := n;
            ParseFileReq := TRUE;
            END
        ELSE
            BEGIN
            DisplayHelp('Expected File Identifier');
            ParseFileReq := FALSE;
            END;
    END;
END;

FUNCTION ParseParameters:BOOLEAN;
CONST CR = CHR(13);
VAR
    ch :CHAR;
    n :LONGINT;
    str :Str255;
    flag :BOOLEAN;
BEGIN
    allTypes := TRUE; allNums := TRUE; allFiles := TRUE;
    ShowType := '    ';
    ch := ' ';
    ch := SkipSpace(ch);
    IF ch = CR THEN
        ParseParameters := TRUE
    ELSE IF ch = ',' THEN
        BEGIN
        ch := dcmdGetNextChar; { eat comma }
        ParseParameters := ParseFileReq(' ');
        END
    ELSE
        BEGIN
            allTypes := FALSE;
            ch := dcmdGetNextParameter(str);
            IF length(str) > 3 THEN
                BEGIN
                    ShowType[1] := str[1];
                    ShowType[2] := str[2];
                    ShowType[3] := str[3];
                    ShowType[4] := str[4];
                END;
            ch := SkipSpace(ch);
            IF ch = ',' THEN
                BEGIN
                ch := dcmdGetNextChar; { eat comma }
                ParseParameters := ParseFileReq(' ');
                END
            ELSE IF ch = CR THEN
                ParseParameters := TRUE
            ELSE BEGIN
                ch := dcmdGetNextExpression(n,flag);
                IF NOT flag THEN
                    BEGIN
                    DisplayHelp('Expected resource ID.');
                    ParseParameters := FALSE
                    END
                ELSE BEGIN
                    allNums := FALSE;
                    ResNum := n;

                    ch := SkipSpace(ch);
                    IF ch = CR THEN
                        ParseParameters := TRUE
                    ELSE
                        ParseParameters := ParseFileReq(ch);
                END;
            END;
        END;
END;

FUNCTION Upper(c: CHAR): CHAR;
BEGIN
    IF (c >= 'a') AND (c <= 'z')
    THEN Upper := CHR(ORD(c)-ORD('a')+ORD('A'))
    ELSE Upper := c;
END;

FUNCTION StrCmp(s1,s2:Str255):BOOLEAN;
VAR len,i :INTEGER;
BEGIN
    len := Length(s1);
    IF len <> Length(s2) THEN StrCmp := FALSE
    ELSE BEGIN
        FOR i := 1 TO len DO
            BEGIN
            IF Upper(s1[i]) <> Upper(s2[i]) THEN BEGIN StrCmp := FALSE; EXIT(StrCmp); END;
            END;
        StrCmp := TRUE;
    END;
END;

PROCEDURE GetFileName(fRefNum:LongInt; VAR t:Str255);
CONST
    FCBSPtr    = $34E;     { low memory global to File Control Block Strings }
VAR
    myStrPtr :StringPtr;
BEGIN  { Look up a file name in the File Control Block. }
    myStrPtr := StringPtr(LongPtr(FCBSPtr)^ + (fRefNum+62));
    t := myStrPtr^; { it's a pascal string in the FCB. }
END;

    { show the list of attributes for a particular resource. Uppercase means active. }
PROCEDURE ShowBits(VAR s:Str255; attrs:rAttrSet);
VAR ch :Str255;
BEGIN
    IF changed IN attrs THEN
        ch := 'C'
    ELSE
        ch := 'c';
    s := Concat(s,ch);
    IF preload IN attrs THEN
        ch := 'D'
    ELSE
        ch := 'd';
    s := Concat(s,ch);
    IF protected IN attrs THEN
        ch := 'T'
    ELSE
        ch := 't';
    s := Concat(s,ch);
    IF locked IN attrs THEN
        ch := 'L'
    ELSE
        ch := 'l';
    s := Concat(s,ch);
    IF purgable IN attrs THEN
        ch := 'P'
    ELSE
        ch := 'p';
    s := Concat(s,ch);
    IF sysAppHeap IN attrs THEN
        ch := 'S'
    ELSE
        ch := 'A';
    s := Concat(s,ch);
END;

PROCEDURE ShowName(VAR s:Str255; name:StringPtr); { build the resource name. }
VAR t :Str255;
BEGIN
    s := Concat(s,'   Name: ');
    t := name^; { it's a pascal string in the resource name list. }
    s := Concat(s,t);
END;

FUNCTION StripAddr(n: Handle): LONGINT;
CONST
    MaskHandle = $31a;
BEGIN
    StripAddr := BAnd(LongInt(n),LongPtr(MaskHandle)^);
END;

PROCEDURE ResInfo(rList:RefListPtr; count:INTEGER; names:StringPtr);
VAR
    i :INTEGER;
    sPtr :StringPtr;
    s,t :Str255;
BEGIN
    FOR i := 0 TO count DO { show info for all resources of this type }
        WITH rList^[i] DO
            BEGIN
                IF allNums OR (ResNum = idNum) THEN
                    BEGIN
                        NumberToDecimal(idNum,t,6);
                        s := Concat('  ID: ',t);
                        s := Concat(s,'   at: ');
                        IF resource = NIL THEN { for loaded resources show the Master Pointer address }
                            t := 'Unloaded'
                        ELSE
                            NumberToHex(StripAddr(resource),t,8);

                        s := Concat(s,t);
                        IF LongInt(resource) < 0 THEN { Is the Locked bit set? }
                            s := Concat(s,' *  Attribs: ') { Yes. }
                        ELSE
                            s := Concat(s,'    Attribs: '); { No. }

                        ShowBits(s,resAttrs); { show the resource attributes. }
                        IF nameOffset <> -1 THEN
                            BEGIN
                            sPtr := StringPtr(LONGINT(names) + LONGINT(nameOffset));
                            ShowName(s,sPtr); { show the resource name, if one. }
                            END;
                        dcmdDrawLine(s);
                    END;
            END;
END;

PROCEDURE ResTypes(typList:TypeListPtr; names:StringPtr; VAR abort:BOOLEAN);
VAR
    i :INTEGER;
    rListPtr :RefListPtr;
    s,t :Str255;
BEGIN
    WITH typList^ DO
        BEGIN
        {
        IntToStr(count+1,t,4);
        Concat(' Number of Resource types: ',t,s);
        dcmdDrawLine(s);
        }
        FOR i := 0 TO count DO { loop through every type of resource. }
            BEGIN
            IF abort THEN Exit(ResTypes);
            WITH list[i] DO
                IF allTypes OR (LONGINT(ShowType)=LONGINT(rType)) THEN
                    BEGIN
                    t := '    ';
                    t[1] := rType[1];
                    t[2] := rType[2];
                    t[3] := rType[3];
                    t[4] := rType[4];
                    s := Concat(' type: ',t);
                    s := Concat(s,'  Instances: ');
                    NumberToDecimal(cnt+1,t,4);
                    s := Concat(s,t);
                    dcmdDrawLine(s);
                    rListPtr := RefListPtr(LONGINT(typList) + LONGINT(offset));
                    ResInfo(rListPtr,cnt,names);
                    END;
            END;
        END;
END;

PROCEDURE DisplayHelp(s:Str255);
BEGIN
    dcmdDrawLine(s);
    dcmdDrawLine('RD [resType[ resNum]] [,"fileName"|fileNum]');
    dcmdDrawLine('   Displays the specified resources and resource files.');
END;

PROCEDURE CommandEntry(paramBlk:DCmdBlockPtr);
CONST
    TopMapHndl    = $A50;    {ResMapHnd - low memory global to the first map in the map list. }
VAR
    fileRef :INTEGER;
    tlPtr :TypeListPtr;
    namesPtr :StringPtr;
    NextResFile :ResMapHnd;
    s,t :Str255;
BEGIN
    IF paramBlk^.request = dcmdHelp THEN
        BEGIN
            DisplayHelp('');
            Exit(CommandEntry);
        END
    ELSE IF paramBlk^.request = dcmdInit THEN
        BEGIN
            Exit(CommandEntry);
        END;
    { Get the command paramters }
    IF NOT ParseParameters THEN Exit(CommandEntry);

    NextResFile := ResMapHnd(ResMapHnd(TopMapHndl)^);
    dcmdDrawLine('Resource Chain - Top to bottom:');
    REPEAT { loop through all resource files. }
        fileRef := NextResFile^^.fRefNum;

        NumberToHex(LongInt(NextResFile^),t,8);
        s := Concat('Map at: ',t);
        s := Concat(s,'  File RefNum: $');
        NumberToHex(fileRef,t,6);
        s := Concat(s,t);

        GetFileName(fileRef,t);
        s := Concat(s,'  File Name: ');
        s := Concat(s,t);
        dcmdDrawLine(s);
        IF allFiles OR (FileNum = fileRef) OR StrCmp(FileName,t) THEN
            BEGIN
            { find pointers to the type list and the resource name list. }
            tlPtr := TypeListPtr(LONGINT(NextResFile^) +
                            LONGINT(NextResFile^^.typeListOffset));
            namesPtr := StringPtr(LONGINT(NextResFile^) +
                            LONGINT(NextResFile^^.nameListOffset));
            ResTypes(tlPtr,namesPtr,paramBlk^.aborted);
            END;
        IF paramBlk^.aborted THEN Exit(CommandEntry);
        NextResFile := ResMapHnd(NextResFile^^.nextMap);
        UNTIL NextResFile = NIL; { null terminated list. }
END;
END.